home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / quikcmd3.zip / SSETS.LSP < prev    next >
Lisp/Scheme  |  1992-07-05  |  8KB  |  260 lines

  1. ;  SSETS.LSP
  2.  ;
  3.  ;                         QUICK COMMAND Release 3.0
  4.  ;                   SSETS.LSP is a module of QUICK COMMAND
  5. ;                       Copyright 1989, 90, 92 Dan Jincks
  6.  ;
  7.  ;
  8. ;              This is SHAREWARE, it is NOT Public Domain software.
  9.  ;
  10.  ;              This code or any part of this code may not be reproduced
  11.  ;              in any publication without prior written permission.
  12.  ;
  13.  ;              Printed copy of this code or any part of this code may not
  14.  ;              be distributed without prior written permission.
  15.  ;
  16.  ;              Printed copy may only be made for reference purposes by
  17.  ;              the end user.
  18.  ;
  19.  ;
  20.  ;                               Dan Jincks
  21.  ;                             Box 155A HCR 77
  22.  ;                           Annapolis, MO 63620
  23.  ;
  24.  ;
  25.  ;
  26.  ;   You are granted a limited license to use SSETS.LSP for a 30 day trial
  27.  ;   period.  If you wish to continue using any or all of QUICK COMMAND after
  28.  ;   the trial period, you must become a registered user.  As a registered
  29.  ;   user, you may use QUICK COMMAND on 1 workstation or terminal.
  30.  ;   Additional registrations must be bought for each additional workstation or
  31.  ;   terminal.  To become a registered user, see QC3.DOC
  32.  ;
  33.  ;
  34.  ;   You may send copies of QUICK COMMAND to friends and associates if you abide
  35.  ;   by the following rules:
  36.  ;
  37.  ;   1. It may only be distributed in the original unmodified form.
  38.  ;   2. All original files must be included.
  39.  ;   3. No addition files may be added.
  40.  ;   4. If other files will be on the same disk, QUICK COMMAND files must be in
  41.  ;      a library format such as ".ARC" called "QUICKCMD", or else be put alone
  42.  ;      in a subdirectory called "QUICKCMD".
  43.  ;   5. You may not sell QUICK COMMAND or any part of it.
  44.  ;   6. You are not allowed to charge more then $5 to cover the cost of copying
  45.  ;      and distribution.
  46.  ;   7. You may not distribute any hard copy of the contents of QUICK COMMAND.
  47.  ;
  48.  ;
  49.  ;   These AutoLISP commands and functions are designed to save you time, and
  50.  ;   saving time means saving money.  The registration fee is very modest
  51.  ;   compared to the savings, and much less expensive then typical third party
  52.  ;   AutoCAD software. Be sure to registar if you continue to use them.
  53.  ;
  54.  ;
  55.  ;                                                               DAN
  56.  ;
  57.  ;
  58.  ;
  59.  ;
  60.  ;        AutoCAD and AutoLISP are registered trade marks of Autodesk Inc.
  61.  ;
  62.  ;        ***************************************************************
  63.  ;
  64.  ;   Begin SSETS.LSP
  65.  ;
  66.  
  67. ;  S1S function
  68.  
  69. (defun C:S1S ()(terpri)
  70.    (prompt " Construct selection set SS1 for use in this editing session. . .")
  71.    (terpri)
  72.    (prompt " Type !SS1 to recall in a command. ")
  73.    (terpri)
  74.    (setq SS1 (ssget))
  75. )
  76.  
  77. ;  S2S function
  78.  
  79. (defun C:S2S ()(terpri)
  80.    (prompt " Construct selection set SS2 for use in this editing session. . .")
  81.    (terpri)
  82.    (prompt " Type !SS2 to recall in a command. ")
  83.    (terpri)
  84.    (setq SS2 (ssget))
  85. )
  86.  
  87. ;  S1A function
  88.  
  89. (defun C:S1A(/ SCE SCA SCB SCC)
  90.    (prompt "Select objects to add to set SS1. . .  ")(terpri)
  91.    (setq SCA (getvar "blipmode"))
  92.    (setvar "blipmode" 1)
  93.    (setvar "cmdecho" 0)
  94.    (command "select" SS1)
  95.    (setq SCB 0)
  96.    (setq SCC (ssget))
  97.    (command "")
  98.    (setq SCE (ssname SCC SCB))
  99.    (while (/= SCE nil)(progn
  100.       (ssadd SCE SS1)
  101.       (setq SCB (1+ SCB))
  102.       (setq SCE (ssname SCC SCB))
  103.       )
  104.    )
  105.    (prompt "New SS1 is highlighted...  Press <ENTER>")
  106.    (command "select" SS1 pause)
  107.    (setvar "cmdecho" 1)
  108.    (setvar "blipmode" SCA)(princ)
  109. )
  110.  
  111. ;  S2A function
  112.  
  113. (defun C:S2A(/ SCE SCA SCB SCC)
  114.    (prompt "Select objects to add to set SS2. . .  ")(terpri)
  115.    (setq SCA (getvar "blipmode"))
  116.    (setvar "blipmode" 1)
  117.    (setvar "cmdecho" 0)
  118.    (command "select" SS2)
  119.    (setq SCB 0)
  120.    (setq SCC (ssget))
  121.    (command "")
  122.    (setq SCE (ssname SCC SCB))
  123.    (while (/= SCE nil)(progn
  124.       (ssadd SCE SS2)
  125.       (setq SCB (1+ SCB))
  126.       (setq SCE (ssname SCC SCB))
  127.       )
  128.    )
  129.    (prompt "New SS2 is highlighted...  Press <ENTER>")
  130.    (command "select" SS2 pause)
  131.    (setvar "cmdecho" 1)
  132.    (setvar "blipmode" SCA)(princ)
  133. )
  134.  
  135. ;  S1R function
  136.  
  137. (defun C:S1R(/ SCE SCA)
  138.    (prompt "Pick objects to remove from set SS1. . .  ") (terpri)
  139.    (setq SCA (getvar "blipmode"))
  140.    (setvar "blipmode" 1)
  141.    (setvar "cmdecho" 0)
  142.    (command "select" SS1)
  143.    (setq SCE (entsel))
  144.    (while (/= SCE nil)(progn
  145.       (command "")
  146.       (setq SCE (car SCE))
  147.       (ssdel SCE SS1)
  148.       (command "select" SS1)
  149.       (setq SCE (entsel))
  150.       )
  151.    )
  152.    (command "")
  153.    (setvar "cmdecho" 1)
  154.    (setvar "blipmode" SCA)
  155. )
  156.  
  157. ;  S2R function
  158.  
  159. (defun C:S2R(/ SCE SCA)
  160.    (prompt "Pick objects to remove from set SS2. . .  ") (terpri)
  161.    (setq SCA (getvar "blipmode"))
  162.    (setvar "blipmode" 1)
  163.    (setvar "cmdecho" 0)
  164.    (command "select" SS2)
  165.    (setq SCE (entsel))
  166.    (while (/= SCE nil)(progn
  167.       (command "")
  168.       (setq SCE (car SCE))
  169.       (ssdel SCE SS2)
  170.       (command "select" SS2)
  171.       (setq SCE (entsel))
  172.       )
  173.    )
  174.    (command "")
  175.    (setvar "cmdecho" 1)
  176.    (setvar "blipmode" SCA)
  177. )
  178.  
  179. ;  S1H function
  180.  
  181. (defun C:S1H (/ SCA)
  182.    (setq SCA (getvar "cmdecho"))
  183.    (setvar "cmdecho" 0)
  184.    (prompt "Selection set SS1 is highlighted...  Press ENTER ")
  185.    (command "select" SS1 pause )
  186.    (setvar "cmdecho" SCA)
  187. )
  188.  
  189. ;  S2H function
  190.  
  191. (defun C:S2H (/ SCA)
  192.    (setq SCA (getvar "cmdecho"))
  193.    (setvar "cmdecho" 0)
  194.    (prompt "Selection set SS2 is highlighted...  Press ENTER ")
  195.    (command "select" SS2 pause )
  196.    (setvar "cmdecho" SCA)
  197. )
  198.  
  199. ;  S2F1 function
  200.  
  201. (defun C:S2F1 (/ SCA SCB SCC SCD SCE)
  202.    (setvar "cmdecho" 0)
  203.    (command "select" SS1)
  204.    (initget 1 "Line Circle Point POLyline Arc Text")
  205.    (setq SCA (strcase (getkword "Type of entity in SS1 to be put into SS2.
  206.    Line, Circle, Arc, Point, Text or POLyline...  ")))(terpri)
  207.    (prompt "         working... please wait...     ")(terpri)
  208.    (command "")
  209.    (if (= SS2 nil)(progn
  210.       (setq SS2 (ssadd))))
  211.    (setq SCC 0)
  212.    (setq SCE (ssname SS1 SCC))
  213.    (while (/= SCE nil)(progn
  214.       (setq SCB (entget SCE ))
  215.       (setq SCD (cdr (assoc 0 SCB)))
  216.       (if (= SCD SCA)(progn
  217.          (ssadd SCE SS2)
  218.          )
  219.       )
  220.    (setq SCC (1+ SCC))
  221.    (setq SCE (ssname SS1 SCC))
  222.    (if (= SCE nil)(progn
  223.       (prompt "  Done...  SS2 is highlighted...   Press enter to continue ")
  224.       (command "select" SS2 pause )
  225.       (setvar "cmdecho" 1)))
  226.    ))(princ)
  227. )
  228.  
  229. ;  S1F2 function
  230.  
  231. (defun C:S1F2 (/ SCA SCB SCC SCD SCE)
  232.    (setvar "cmdecho" 0)
  233.    (command "select" SS2)
  234.    (initget 1 "Line Circle Point POLyline Arc Text")
  235.    (setq SCA (strcase (getkword "Type of entity in SS2 to be put into SS1.
  236.    Line, Circle, Arc, Point, Text or POLyline...  ")))(terpri)
  237.    (prompt "         working... please wait...     ")(terpri)
  238.    (command "")
  239.    (if (= SS1 nil)(progn
  240.       (setq SS1 (ssadd))))
  241.    (setq SCC 0)
  242.    (setq SCE (ssname SS2 SCC))
  243.    (while (/= SCE nil)(progn
  244.       (setq SCB (entget SCE))
  245.       (setq SCD (cdr (assoc 0 SCB)))
  246.       (if (= SCD SCA)(progn
  247.          (ssadd SCE SS1)
  248.          )
  249.       )
  250.    (setq SCC (1+ SCC))
  251.    (setq SCE (ssname SS2 SCC))
  252.    (if (= SCE nil)(progn
  253.       (prompt "  Done...  SS1 is highlighted...   Press enter to continue ")
  254.       (command "select" SS1 pause )
  255.       (setvar "cmdecho" 1)))
  256.    ))(princ)
  257. )
  258.  ;
  259.  ;   End SSETS.LSP
  260.